home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0043_File Sharing.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  8KB  |  360 lines
  1. {
  2. Also, please note, this unit has not been completely tested.  It may
  3. (and most probably does) have bugs in it.  If (and when) any are
  4. discovered, please contact me, so I can update my routines also.
  5.  
  6. **************************
  7. *     SHARE.PAS v1.0     *
  8. *                        *
  9. *  General purpose file  *
  10. *    sharing routines    *
  11. **************************
  12.  
  13. 1992-93 HyperDrive Software
  14. Released into the public domain.
  15. }
  16.  
  17. {$S-,R-,D-}
  18. {$IFOPT O+}
  19.   {$F+}
  20. {$ENDIF}
  21.  
  22. unit Share;
  23.  
  24. interface
  25.  
  26. const
  27.   MaxLockRetries : Byte = 10;
  28.  
  29.   NormalMode = $02; { ---- 0010 }
  30.   ReadOnly   = $00; { ---- 0000 }
  31.   WriteOnly  = $01; { ---- 0001 }
  32.   ReadWrite  = $02; { ---- 0010 }
  33.   DenyAll    = $10; { 0001 ---- }
  34.   DenyWrite  = $20; { 0010 ---- }
  35.   DenyRead   = $30; { 0011 ---- }
  36.   DenyNone   = $40; { 0100 ---- }
  37.   NoInherit  = $70; { 1000 ---- }
  38.  
  39. type
  40.   Taskers = (NoTasker, DesqView, DoubleDOS, Windows, OS2, NetWare);
  41.  
  42. var
  43.   MultiTasking : Boolean;
  44.   MultiTasker  : Taskers;
  45.   VideoSeg     : Word;
  46.   VideoOfs     : Word;
  47.  
  48. procedure SetFileMode(Mode : Word);
  49. {- Set filemode for typed/untyped files }
  50. procedure ResetFileMode;
  51. {- Reset filemode to ReadWrite (02h) }
  52. procedure LockFile(var F);
  53. {- Lock file F }
  54. procedure UnLockFile(var F);
  55. {- Unlock file F }
  56. procedure LockBytes(var F;  Start, Bytes : LongInt);
  57. {- Lock Bytes bytes of file F, starting with Start }
  58. procedure UnLockBytes(var F;  Start, Bytes : LongInt);
  59. {- Unlock Bytes bytes of file F, starting with Start }
  60. procedure LockRecords(var F;  Start, Records : LongInt);
  61. {- Lock Records records of file F, starting with Start }
  62. procedure UnLockRecords(var F;  Start, Records : LongInt);
  63. {- Unlock Records records of file F, starting with Start }
  64. function  TimeOut : Boolean;
  65. {- Check for LockRetry timeout }
  66. procedure TimeOutReset;
  67. {- Reset internal LockRetry counter }
  68. function  InDos: Boolean;
  69. {- Is DOS busy? }
  70. procedure GiveTimeSlice;
  71. {- Give up remaining CPU time slice }
  72. procedure BeginCrit;
  73. {- Enter critical region }
  74. procedure EndCrit;
  75. {- End critical region }
  76.  
  77. implementation
  78.  
  79. uses
  80.   Dos;
  81.  
  82. var
  83.   InDosFlag : ^Word;
  84.   LockRetry : Byte;
  85.  
  86. procedure FLock(Handle : Word; Pos, Len : LongInt);
  87. Inline(
  88.   $B8/$00/$5C/    {  mov   AX,$5C00        ;DOS FLOCK, Lock subfunction}
  89.   $8B/$5E/$04/    {  mov   BX,[BP + 04]    ;Place file handle in Bx register}
  90.   $C4/$56/$06/    {  les   DX,[BP + 06]    ;Load position in ES:DX}
  91.   $8C/$C1/        {  mov   CX,ES           ;Move ES pointer to CX register}
  92.   $C4/$7E/$08/    {  les   DI,[BP + 08]    ;Load length in ES:DI}
  93.   $8C/$C6/        {  mov   SI,ES           ;Move ES pointer to SI register}
  94.   $CD/$21);       {  int   $21             ;Call DOS}
  95.  
  96. procedure FUnlock(Handle : Word; Pos, Len : LongInt);
  97. Inline(
  98.   $B8/$01/$5C/    {  mov   AX,$5C01        ;DOS FLOCK, Unlock subfunction}
  99.   $8B/$5E/$04/    {  mov   BX,[BP + 04]    ;Place file handle in Bx register}
  100.   $C4/$56/$06/    {  les   DX,[BP + 06]    ;Load position in ES:DX}
  101.   $8C/$C1/        {  mov   CX,ES           ;Move ES pointer to CX register}
  102.   $C4/$7E/$08/    {  les   DI,[BP + 08]    ;Load length in ES:DI}
  103.   $8C/$C6/        {  mov   SI,ES           ;Move ES pointer to SI register}
  104.   $CD/$21);       {  int   $21             ;Call DOS}
  105.  
  106. procedure SetFileMode(Mode : Word);
  107. begin
  108.   FileMode := Mode;
  109. end;
  110.  
  111. procedure ResetFileMode;
  112. begin
  113.   FileMode := NormalMode;
  114. end;
  115.  
  116. procedure LockFile(var F);
  117. begin
  118.   If not MultiTasking then
  119.     Exit;
  120.  
  121.   While InDos do
  122.     GiveTimeSlice;
  123.  
  124.   FLock(FileRec(F).Handle, 0, FileSize(File(F)));
  125. end;
  126.  
  127. procedure UnLockFile(var F);
  128. begin
  129.   If not MultiTasking then
  130.     Exit;
  131.  
  132.   While InDos do
  133.     GiveTimeSlice;
  134.  
  135.   FLock(FileRec(F).Handle, 0, FileSize(File(F)));
  136. end;
  137.  
  138. procedure LockBytes(var F;  Start, Bytes : LongInt);
  139. begin
  140.   If not MultiTasking then
  141.     Exit;
  142.  
  143.   While InDos do
  144.     GiveTimeSlice;
  145.  
  146.   FLock(FileRec(F).Handle, Start, Bytes);
  147. end;
  148.  
  149. procedure UnLockBytes(var F;  Start, Bytes : LongInt);
  150. begin
  151.   If not MultiTasking then
  152.     Exit;
  153.  
  154.   While InDos do
  155.     GiveTimeSlice;
  156.  
  157.   FLock(FileRec(F).Handle, Start, Bytes);
  158. end;
  159.  
  160. procedure LockRecords(var F;  Start, Records : LongInt);
  161. begin
  162.   If not MultiTasking then
  163.     Exit;
  164.  
  165.   While InDos do
  166.     GiveTimeSlice;
  167.  
  168.   FLock(FileRec(F).Handle, Start * FileRec(F).RecSize, Records * FileRec(F).RecSize);
  169. end;
  170.  
  171. procedure UnLockRecords(var F;  Start, Records : LongInt);
  172. begin
  173.   If not MultiTasking then
  174.     Exit;
  175.  
  176.   While InDos do
  177.     GiveTimeSlice;
  178.  
  179.   FLock(FileRec(F).Handle, Start * FileRec(F).RecSize, Records * FileRec(F).RecSize);
  180. end;
  181.  
  182. function TimeOut : Boolean;
  183. begin
  184.   GiveTimeSlice;
  185.   TimeOut := True;
  186.  
  187.   If MultiTasking and (LockRetry < MaxLockRetries) then
  188.   begin
  189.     TimeOut := False;
  190.     Inc(LockRetry);
  191.   end;
  192. end;
  193.  
  194. procedure TimeOutReset;
  195. begin
  196.   LockRetry := 0;
  197. end;
  198.  
  199. function InDos : Boolean;
  200. begin
  201.   InDos := InDosFlag^ > 0;
  202. end;
  203.  
  204. procedure GiveTimeSlice;  ASSEMBLER;
  205. asm
  206.   cmp   MultiTasker, DesqView
  207.   je    @DVwait
  208.   cmp   MultiTasker, DoubleDOS
  209.   je    @DoubleDOSwait
  210.   cmp   MultiTasker, Windows
  211.   je    @WinOS2wait
  212.   cmp   MultiTasker, OS2
  213.   je    @WinOS2wait
  214.   cmp   MultiTasker, NetWare
  215.   je    @Netwarewait
  216.  @Doswait:
  217.   int   $28
  218.   jmp   @WaitDone
  219.  @DVwait:
  220.   mov   AX,$1000
  221.   int   $15
  222.   jmp   @WaitDone
  223.  @DoubleDOSwait:
  224.   mov   AX,$EE01
  225.   int   $21
  226.   jmp   @WaitDone
  227.  @WinOS2wait:
  228.   mov   AX,$1680
  229.   int   $2F
  230.   jmp   @WaitDone
  231.  @Netwarewait:
  232.   mov   BX,$000A
  233.   int   $7A
  234.   jmp   @WaitDone
  235.  @WaitDone:
  236. end;
  237.  
  238. procedure BeginCrit;  ASSEMBLER;
  239. asm
  240.   cmp   MultiTasker, DesqView
  241.   je    @DVCrit
  242.   cmp   MultiTasker, DoubleDOS
  243.   je    @DoubleDOSCrit
  244.   cmp   MultiTasker, Windows
  245.   je    @WinCrit
  246.   jmp   @EndCrit
  247.  @DVCrit:
  248.   mov   AX,$101B
  249.   int   $15
  250.   jmp   @EndCrit
  251.  @DoubleDOSCrit:
  252.   mov   AX,$EA00
  253.   int   $21
  254.   jmp   @EndCrit
  255.  @WinCrit:
  256.   mov   AX,$1681
  257.   int   $2F
  258.   jmp   @EndCrit
  259.  @EndCrit:
  260. end;
  261.  
  262. procedure EndCrit;  ASSEMBLER;
  263. asm
  264.   cmp   MultiTasker, DesqView
  265.   je    @DVCrit
  266.   cmp   MultiTasker, DoubleDOS
  267.   je    @DoubleDOSCrit
  268.   cmp   MultiTasker, Windows
  269.   je    @WinCrit
  270.   jmp   @EndCrit
  271.  @DVCrit:
  272.   mov   AX,$101C
  273.   int   $15
  274.   jmp   @EndCrit
  275.  @DoubleDOSCrit:
  276.   mov   AX,$EB00
  277.   int   $21
  278.   jmp   @EndCrit
  279.  @WinCrit:
  280.   mov   AX,$1682
  281.   int   $2F
  282.   jmp   @EndCrit
  283.  @EndCrit:
  284. end;
  285.  
  286. begin
  287.   {- Init }
  288.   LockRetry:= 0;
  289.  
  290.   asm
  291.    @CheckDV:
  292.     mov   AX, $2B01
  293.     mov   CX, $4445
  294.     mov   DX, $5351
  295.     int   $21
  296.     cmp   AL, $FF
  297.     je    @CheckDoubleDOS
  298.     mov   MultiTasker, DesqView
  299.     jmp   @CheckDone
  300.    @CheckDoubleDOS:
  301.     mov   AX, $E400
  302.     int   $21
  303.     cmp   AL, $00
  304.     je    @CheckWindows
  305.     mov   MultiTasker, DoubleDOS
  306.     jmp   @CheckDone
  307.    @CheckWindows:
  308.     mov   AX, $1600
  309.     int   $2F
  310.     cmp   AL, $00
  311.     je    @CheckOS2
  312.     cmp   AL, $80
  313.     je    @CheckOS2
  314.     mov   MultiTasker, Windows
  315.     jmp   @CheckDone
  316.    @CheckOS2:
  317.     mov   AX, $3001
  318.     int   $21
  319.     cmp   AL, $0A
  320.     je    @InOS2
  321.     cmp   AL, $14
  322.     jne   @CheckNetware
  323.    @InOS2:
  324.     mov   MultiTasker, OS2
  325.     jmp   @CheckDone
  326.    @CheckNetware:
  327.     mov   AX,$7A00
  328.     int   $2F
  329.     cmp   AL,$FF
  330.     jne   @NoTasker
  331.     mov   MultiTasker, NetWare
  332.     jmp   @CheckDone
  333.    @NoTasker:
  334.     mov   MultiTasker, NoTasker
  335.    @CheckDone:
  336.     {-Set MultiTasking }
  337.     cmp   MultiTasker, NoTasker
  338.     mov   VideoSeg, $B800
  339.     mov   VideoOfs, $0000
  340.     je    @NoMultiTasker
  341.     mov   MultiTasking, $01
  342.     {-Get video address }
  343.     mov   AH, $FE
  344.     les   DI, [$B8000000]
  345.     int   $10
  346.     mov   VideoSeg, ES
  347.     mov   VideoOfs, DI
  348.     jmp   @Done
  349.    @NoMultiTasker:
  350.     mov   MultiTasking, $00
  351.    @Done:
  352.     {-Get InDos flag }
  353.     mov   AH, $34
  354.     int   $21
  355.     mov   WORD PTR InDosFlag, BX
  356.     mov   WORD PTR InDosFlag + 2, ES
  357.   end;
  358. end.
  359.  
  360.